home *** CD-ROM | disk | FTP | other *** search
/ Aminet 39 / Aminet 39 (2000)(Schatztruhe)[!][Oct 2000].iso / Aminet / biz / swood / FW_AllInOne.lha / Makros / FontLook.long < prev    next >
Text File  |  1998-01-23  |  26KB  |  803 lines
  1. /********************************************
  2.  * FontLook(Auto) für FW4+                  *
  3.  * $VER: 4.1  © Heiko Schröder  (09.01.98)  *
  4.  ********************************************/
  5.  
  6. /* Neu:    speed it up
  7.            12 Zeichensätze, speichern, neuesdok -> speicher sparen
  8.            Schriftschnitte bei Layout
  9.            Eigener Voreinsteller*/
  10.  
  11. Parse ARG FW
  12.  
  13. if ~show('L',"rexxreqtools.library") then
  14.    if ~addlib('rexxreqtools.library',0,-30,0) then do
  15.       'ShowMessage 1 1 "Fehler...." "Benötige Libs:rexxreqtools.library" " A B B R U C H ! !" "Okay" "" ""'
  16.       exit
  17.    end
  18. IF ~show('L','tritonrexx.library') then
  19.    IF ~ADDLIB('tritonrexx.library',10,-30,0) THEN DO
  20.       'ShowMessage 2 1 "Fehler...." "Benötige Libs:tritonrexx.library" "" "Abbruch" "" ""'
  21.       exit
  22.    END
  23.  
  24. R='0A'X
  25.  
  26. If FW='' then do
  27.    Address='FinalW'
  28.    Options results
  29.  
  30.    STATUS PORTNAME
  31.    FW=result
  32. End
  33.    address(FW)
  34.  
  35. SIGNAL ON SYNTAX
  36.  
  37. address "REXX"
  38. If open('Hilfe',"S:FW_Paket.prefs","R") then do
  39.    HilfeVerz=readln('Hilfe')
  40.    Call Close('Hilfe')
  41. End
  42. else HilfeVerz=''
  43.  
  44. If open('pref','S:FW_FontLook.prefs','R')~=0 then do
  45.    Art     =readln('pref')  /*verz(0) oder file(1)*/
  46.    Ausgabe =readln('pref')  /*code(0) oder layout(1) oder Übersicht(2)*/
  47.    Schnitte=readln('pref') /* dazugehörige Schnitte */
  48.    Locher  =readln('pref')  /*lochermarke?*/
  49.    Gesch   =readln('pref')  /*normal(0) oder speed(1)*/
  50.    Speich  =readln('pref')  /*speichern(0), drucken(1), beides(2)*/
  51.    auswd   =readln('pref')  /*ausgewähltes dir*/
  52.    auswf   =readln('pref')  /*ausgewähltes filedir*/
  53.    call close('pref')
  54. END
  55. else do
  56.    Art=0; Ausgabe=0; Locher=0
  57.    Gesch=0; Speich=0
  58.    auswd=''; auswf=''; Schnitte=0
  59. END
  60.  
  61. ausw=''
  62.  
  63. Artlist.0 = 2
  64. Artlist.1 = 'Schriftartenverzeichnis'
  65. Artlist.2 = 'einzelne Schriftart'
  66.  
  67. Speichlist.0 = 3
  68. Speichlist.1 = 'Speichern'
  69. Speichlist.2 = 'Drucken'
  70. Speichlist.3 = 'Beides'
  71.  
  72. Geschlist.0 = 2
  73. Geschlist.1 = 'normal'
  74. Geschlist.2 = 'schnell'
  75.  
  76. Ausgabelist.0 = 3
  77. Ausgabelist.1 = 'Code'
  78. Ausgabelist.2 = 'Layout'
  79. Ausgabelist.3 = 'Übersicht'
  80.  
  81. If Ausgabe~=1 then Disi=1   /* Schnittform anwählbar?*/
  82.    else Disi=0
  83.  
  84. If Locher=0 then LocherText="Nein"
  85.    Else LocherText="Ja"
  86.  
  87. o1="Geschwindigkeit: "||Geschlist.Gesch||", Lochermarken: "||LocherText
  88. o2="Speichern/Drucken: "||Speichlist.Speich
  89.  
  90. apptags =      'TRCA_Name     FontLook',
  91.                'TRCA_LongName "FontLook"',
  92.                'TRCA_Info     "Makro für Finalwriter"',
  93.                'TRCA_Version  "4.1 registered"',
  94.                'TRCA_Release  "2"',
  95.                'TRCA_Date     "09.01.98"',
  96.                'TAG_END'
  97.  
  98. windowtags =   WindowID(1),
  99.                WindowPosition('TRWP_CENTERDISPLAY'),
  100.                WindowFlags('TRWF_NOMINTEXTWIDTH|TRWF_NOSIZEGADGET'),
  101.                PubScreenName('FinalWriterPubScreen'),
  102.                WindowTitle('FontLook'),
  103.                BeginMenu('Projekt'),
  104.                   MenuItem('Voreinsteller...',102),
  105.                   'ItemBarlabel',
  106.                   MenuItem('Q_Verlassen...',104),
  107.                BeginMenu('?'),
  108.                   MenuItem('?_Info',101),
  109.                   MenuItem('H_Hilfe',103),
  110.                'HorizGroupAC SpaceS',
  111.                   'VertGroupAC SpaceS',
  112.                      CycleGadget('Artlist',Art,11) 'TRAT_Flags TRCY_RIGHTLABELS',
  113.                      'HorizGroupAC',
  114.                         GetEntryButton(12),
  115.                         StringGadget('',13),
  116.                      'EndGroup',
  117.                      'Space',
  118.                      'HorizGroupAC',
  119.                         CycleGadget('Ausgabelist',Ausgabe,14) 'TRAT_Flags TRCY_RIGHTLABELS',
  120.                         'SpaceS',
  121.                         CheckBox(15) 'TRAT_VALUE' Schnitte 'TRAT_DISABLED' Disi,
  122.                         'SpaceS',
  123.                         TextID("_Schriftschnitte",15),
  124.                      'EndGroup',
  125.                      'Space',
  126.                      'HorizSeparator',
  127.                      'SpaceS',
  128.                      TextH(o1) 'TRAT_ID 16',
  129.                      TextH(o2) 'TRAT_ID 17',
  130.                      'SpaceS',
  131.                      Progress(100,0,7),
  132.                      'SpaceS',
  133.                      'HorizGroupSA',
  134.                          TextN("0"),
  135.                          'SpaceB SpaceB',
  136.                          TextN("25"),
  137.                          'SpaceB SpaceB',
  138.                          TextN("50"),
  139.                          'SpaceB SpaceB',
  140.                          TextN("75"),
  141.                          'SpaceB SpaceB',
  142.                          TextN("100"),
  143.                       'EndGroup',
  144.                       'SpaceS',
  145.                       'HorizGroupEC',
  146.                          Button(' _Anwenden ',1),
  147.                          'SpaceS',
  148.                          Button('Ab_bruch',2),
  149.                       'EndGroup SpaceS',
  150.                    'EndGroup SpaceS',
  151.              'EndGroup SpaceS',
  152.           'EndProject'
  153.  
  154. app = TR_CREATEAPP('TRCA_Name FontLook')
  155.  
  156. IF app~='00000000'x THEN DO
  157.    window1=TR_OPENPROJECT(app,windowtags)
  158.    IF window1~='00000000'x THEN DO
  159.       If Art=0 then CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswd)
  160.       If Art=1 then CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswf)
  161.       ende=0
  162.  
  163.       DO WHILE ende~=1
  164.          CALL TR_WAIT(app,'')
  165.  
  166.          DO WHILE TR_HANDLEMSG(app,'event')
  167.             IF event.trm_class = 'TRMS_CLOSEWINDOW' THEN ende = 1
  168.  
  169.             IF event.trm_class = 'TRMS_NEWVALUE' THEN DO
  170.                SELECT
  171.                   WHEN event.trm_id = 11 THEN DO         /*Verz-Font Auswahl*/
  172.                      Art = event.trm_data
  173.                      If Art = 0 then do
  174.                         CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswd)
  175.                         ausw=auswd
  176.                      END
  177.                      If Art = 1 then do
  178.                         CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswf)
  179.                         ausw=auswf
  180.                      END
  181.                   END
  182.  
  183.                   WHEN event.trm_id = 14 THEN do
  184.                      Ausgabe=event.trm_data             /*Codes-Layout Auswahl*/
  185.                      If Ausgabe~=1 then Call TR_SETATTRIBUTE(window1,15,'TRAT_DISABLED',1)
  186.                         else Call TR_SETATTRIBUTE(window1,15,'TRAT_DISABLED',0)
  187.                   End
  188.  
  189.                   WHEN event.trm_id = 15 THEN DO         /*löschen*/
  190.                      Schnitte = event.trm_data
  191.                   END
  192.  
  193.                   OTHERWISE
  194.                      NOP
  195.                END
  196.             END
  197.  
  198.             IF event.trm_class = 'TRMS_ACTION' THEN DO
  199.                SELECT
  200.                   WHEN event.trm_id = 12 THEN Do      /*RequesterKnopf*/
  201.  
  202.                      If Art = 0 then do                 /*Verz*/
  203.                         dir=rtfilerequest(auswd,,"Verzeichnis auswählen...",,"rt_pubscrname=FinalWriterPubScreen rtfi_flags = freqf_nofiles")
  204.                         if dir='' then auswd=auswd
  205.                            else auswd=dir
  206.                         CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswd)
  207.                         ausw=auswd
  208.                      END
  209.  
  210.                      If Art = 1 then do                 /*File*/
  211.                         pos = max(index(auswf,':'),lastpos('/',auswf))
  212.                         IF (pos~=0) THEN ops=Left(auswf,pos)
  213.                            ELSE ops=auswf
  214.  
  215.                         file=rtfilerequest(ops,,"Font auswählen...","Start","rt_pubscrname=FinalWriterPubScreen")
  216.                         if file='' then auswf=auswf
  217.                            else auswf=file
  218.                         CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswf)
  219.                         ausw=auswf
  220.                      END
  221.                   END
  222.  
  223.                   WHEN event.trm_id = 1 THEN Do                /*Anwenden*/
  224.                      ausw=TR_GETATTRIBUTE(window1,13,'TROB_String')
  225.                      CALL TR_SETATTRIBUTE(window1,7,'TRAT_Value',0)
  226.                      Call Programm
  227.                   END
  228.  
  229.                   WHEN event.trm_id = 2 THEN ende=1            /*Abbruch*/
  230.  
  231.                   WHEN event.trm_id = 101 THEN Call rtezrequest("Aus dem Makro-Paket:"||R||R||"FontLook V4.1 für FW"||R||"© 1998 Heiko Schröder","Danke für Ihre Registrierung.","Info","rt_pubscrname=FinalWriterPubScreen")
  232.                   WHEN event.trm_id = 102 THEN Call Voreinstellung
  233.                   WHEN event.trm_id = 103 THEN address command "run Multiview PUBSCREEN=FinalWriterPubScreen "||d2c(34)||HilfeVerz||"FontLook.guide"||d2c(34)
  234.                   WHEN event.trm_id = 104 THEN ende=1
  235.  
  236.                   OTHERWISE NOP
  237.                END
  238.             END
  239.  
  240.          END
  241.       END
  242.  
  243.       CALL TR_CLOSEPROJECT(window1)
  244.    END
  245.  
  246.    CALL TR_DELETEAPP(app)
  247. END
  248. ELSE
  249.    CALL quit('Kann das Fenster nicht öffnen',10)
  250.  
  251. Exit
  252.  
  253. Programm:
  254.  
  255. Temp="RAM:fonts"
  256. If ausw~='' then do        /*Verzeichnis*/
  257.    ausw='"'||ausw||'"'
  258.    address command 'list ' ausw || ' to=' Temp || ' files lformat "%s%s"'
  259. END
  260. else do
  261.    If Art=0 then ret=rtezrequest("Kein Verzeichnis ausgewählt...","_Achso","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  262.    If Art=1 then ret=rtezrequest("Kein Font ausgewählt...","_Achso","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  263.    Call TR_SendMessage(window1,13,'TROM_ACTIVATE',0)
  264.    Return
  265. END
  266.  
  267. If OPEN('file',Temp,"R") then
  268. Laenge=Seek("file",0,"E")
  269. If Laenge=0 then do
  270.    If Art=0 then ret=rtezrequest("Verzeichnis ist leer...","_Abbruch","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  271.    If Art=1 then ret=rtezrequest("Kein Font ausgewählt...","_Achso","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  272.    address "REXX"
  273.    Call close("file")
  274.    Return
  275. END
  276.  
  277. Call close("file")
  278. address command 'sort ' Temp Temp
  279.  
  280. ret=rtezrequest("Das Makro benötigt ein leeres Dokument."R"Ihr jetziges Dokument wird gelöscht!","_Ja|_Nein","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  281. If ret=0 then Return
  282.  
  283. Call open('file',Temp, "R")
  284.  
  285. address(FW)
  286. ClearDoc FORCE
  287.  
  288. /*----- Schleife bis alle Fonts ausgegeben worden sind -----*/
  289.  
  290. c=0               /*Zähler für Schnitte*/
  291. DO WHILE 1
  292.    TR_HANDLEMSG(app,'event')
  293.    IF event.trm_class = 'TRMS_ACTION' THEN
  294.       If event.trm_id = 2 THEN do
  295.          Call WH
  296.          If Punkt="Comma" then DocItemPrefs DECIMAL Comma
  297.          leave
  298.       End
  299.  
  300.    FondName=ReadLn('file')
  301.     IF EOF('file') THEN do
  302.       Call close('file')
  303.       Address command "delete ram:fonts QUIET"
  304.       If Punkt="Comma" then DocItemPrefs DECIMAL Comma
  305.       leave
  306.    END
  307.    Stand=Seek("file",0,"C")
  308.  
  309.    schonweg=0
  310.    If (Lastpos(".info",FondName)=0 & Lastpos(".otag",FondName)=0 & Lastpos(".type",FondName)=0 & Lastpos(".afm",FondName)=0 & Lastpos(".lib",FondName)=0) then do
  311.    If Schnitte=1 then
  312.       Do g=1 to c
  313.          If pos(upper(Schnitte.g),upper(FondName))~=0 then schonweg=1
  314.       End
  315.    If schonweg=0 then do
  316.  
  317.    /*FensterMinimierung*/
  318.  
  319.    TextTool
  320.    Font FondName
  321.    If RC<=5 then do                  /* Kann FW den Font verarbeiten?*/
  322.  
  323.       Call FontBestimmen
  324.  
  325.       GetDocItemPrefs Decimal
  326.       Punkt=Result
  327.       If Punkt="Comma" then DocItemPrefs DECIMAL Period
  328.  
  329.       IF Gesch=2 THEN do
  330.          View 20
  331.          RedrawOFF
  332.       End
  333.  
  334.       Pagesetup Pagetype A4 Orient Tall Pages RightOnly
  335.       SectionSetup Top 2.54 Bottom 2.54 Inside 2 Outside 1
  336.  
  337.       GraphicTool
  338.       LinePrefs LineWt .5
  339.       DrawLine 1 2 3.5 20 3.5
  340.       if Ausgabe~=2 then DrawLine 1 2 26 20 26
  341.       If Locher=1 then DrawLine 1 .5 14.85 1 14.85
  342.  
  343.       TextTool
  344.       If Ausgabe=0 then do
  345.  
  346.          Do i=0 to 14
  347.             SetTab i*1.2+0.8 Right
  348.          END
  349.  
  350.          NameFont="FWDocs/Codes-" || ShortFondName
  351.          Justify Center
  352.          Font Softsans
  353.          FontSize 18
  354.          Type ShortFondName; NewParagraph; NewParagraph
  355.  
  356.          a=-17
  357.          Justify Left
  358.          DO f=1 to 16
  359.             Font Softsans
  360.             FontSize 8
  361.             zeile=''
  362.             DO j=a+33 to a+47
  363.                zeile = zeile || d2c( 9 ) || j || d2c( 32 ) || d2c( j ) /**/
  364.             END
  365.  
  366.             Type zeile; NewParagraph
  367.             Font ShortFondName
  368.             FontSize 24
  369.             zeile=''
  370.             DO j=a+33 to a+47
  371.                 zeile = zeile || d2c(9) || d2c(j)
  372.             END
  373.             Type zeile; NewParagraph
  374.             a=a+15
  375.          END
  376.  
  377.          Font Softsans
  378.          FontSize 9
  379.          Type d2c(9); NewParagraph
  380.          Justify Right
  381.          Type Date(E)" - "FullFondName
  382.  
  383.       END
  384.  
  385.       If Ausgabe=1 then do
  386.  
  387.          Justify Center
  388.          NameFont="FWDocs/Layout-" || ShortFondName
  389.          Font Softsans
  390.          FontSize 18
  391.          Type ShortFondName; NewParagraph
  392.  
  393.          Justify Left
  394.          Font FullFondName
  395.          FontSize 8
  396.          NewParagraph; Type "This is 8-point type - not easy to read!"; NewParagraph
  397.  
  398.          FontSize 9
  399.          Type "9-Point type is about the smallest readable size."; NewParagraph
  400.  
  401.          FontSize 10
  402.          Type "With 10-point type, we have a normal text size."; NewParagraph
  403.  
  404.          FontSize 12
  405.          Type "With some fonts, 12-point type is easier to read."; NewParagraph
  406.  
  407.          FontSize 14
  408.          Type "14-point type is good for subheadings."; NewParagraph
  409.  
  410.          FontSize 16
  411.          Type "For larger subheadings, try 16-point type."; NewParagraph
  412.  
  413.          FontSize 18
  414.          Type "18-point type makes nice small headlines."; NewParagraph
  415.  
  416.          FontSize 24
  417.          Type "24-point type is for medium headlines."; NewParagraph
  418.  
  419.          FontSize 36
  420.          Type "36-point is for larger ones."; NewParagraph
  421.  
  422.          FontSize 48
  423.          Type "48-point almost shouts!"; NewParagraph
  424.  
  425.          FontSize 12
  426.          Font SoftSans
  427.          Type d2c( 32 ); NewParagraph
  428.  
  429.          Type "Erweiterter Schriftcode"; NewParagraph
  430.  
  431.          FontSize 10
  432.          Font FullFondName
  433.          DO j = 128 BY 32 FOR 4 /* MiK */
  434.             Type XRange( d2c( j ), d2c( j + 31 ) ); NewParagraph /* MiK */
  435.          End
  436.          NewParagraph
  437.  
  438.          Type "Normal"; NewParagraph
  439.  
  440.          FontSize 10
  441.          Font FullFondName
  442.          Type "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; NewParagraph
  443.          Type "abcdefghijklmnopqrstuvwxyz 1234567890 !@#$%^&*()-+=[]{}/:;,.?"; NewParagraph
  444.          Type "The quick brown fox jumps over the lazy dog. ÄÖÜäöüß"
  445.          NewParagraph; NewParagraph
  446.  
  447.          If Schnitte=1 then do
  448.             Font SoftSans
  449.             Type "Bold"; NewParagraph
  450.  
  451.             FontSize 10
  452.             If exists(FullFondName||"_bold") then do
  453.                c=c+1; Schnitte.c=FullFondName||"_bold"
  454.                Font Schnitte.c
  455.                Type "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; NewParagraph
  456.                Type "abcdefghijklmnopqrstuvwxyz 1234567890 !@#$%^&*()-+=[]{}/:;,.?"; NewParagraph
  457.                Type "The quick brown fox jumps over the lazy dog. ÄÖÜäöüß"
  458.             End
  459.             Else do
  460.                Font SoftSans
  461.                Type "Dieser Schriftschnitt existiert nicht."
  462.             End
  463.             NewParagraph; NewParagraph
  464.  
  465.             Font SoftSans
  466.             Type "Italic"; NewParagraph
  467.  
  468.             FontSize 10
  469.             If exists(FullFondName||"_italic") then do
  470.                c=c+1; Schnitte.c=FullFondName||"_italic"
  471.                Font Schnitte.c
  472.                Type "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; NewParagraph
  473.                Type "abcdefghijklmnopqrstuvwxyz 1234567890 !@#$%^&*()-+=[]{}/:;,.?"; NewParagraph
  474.                Type "The quick brown fox jumps over the lazy dog. ÄÖÜäöüß"
  475.             End
  476.             Else do
  477.                Font SoftSans
  478.                Type "Dieser Schriftschnitt existiert nicht."
  479.             End
  480.             NewParagraph; NewParagraph
  481.  
  482.             Font SoftSans
  483.             Type "BoldItalic"; NewParagraph
  484.  
  485.             FontSize 10
  486.             If exists(FullFondName||"_bolditalic") then do
  487.                c=c+1; Schnitte.c=FullFondName||"_bolditalic"
  488.                Font Schnitte.c
  489.                Type "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; NewParagraph
  490.                Type "abcdefghijklmnopqrstuvwxyz 1234567890 !@#$%^&*()-+=[]{}/:;,.?"; NewParagraph
  491.                Type "The quick brown fox jumps over the lazy dog. ÄÖÜäöüß"
  492.             End
  493.             Else do
  494.                Font SoftSans
  495.                Type "Dieser Schriftschnitt existiert nicht."
  496.             End
  497.             NewParagraph; NewParagraph
  498.  
  499.          End
  500.  
  501.          Status BodyTextHeight
  502.          th=result
  503.          FG=26.24-2.113-th
  504.          FG=FG*8%0.34
  505.          FontSize FG
  506.          Type d2c(9)
  507.          Font SoftSans
  508.          FontSize 8
  509.          NewParagraph
  510.          Justify Right
  511.          Type Date(E)" - "FullFondName
  512.       END
  513.  
  514. /*-------------------- Übersicht --------------------------*/
  515.  
  516.       If Ausgabe=2 then do                   /*Testtext*/
  517.          DokAnz=1; FontAnz=0
  518.          Call FontBestimmen
  519.          NameFont="FWDocs/Übersicht-" || Speichname
  520.          Justify Center
  521.          Font Softsans
  522.          FontSize 18
  523.          Type FontVerz||" - "||DokAnz; NewParagraph; NewParagraph; NewParagraph
  524.  
  525.          Justify Left
  526.          Stand=Seek("file",0,"B")
  527.  
  528.          Do While 1
  529.             FondName=ReadLn('file')
  530.              IF EOF('file') THEN do
  531.                Backspace
  532.                Backspace
  533.                Namefont=NameFont||"-"||DokAnz
  534.                leave
  535.             End
  536.  
  537.             If (Lastpos(".info",FondName)=0 & Lastpos(".otag",FondName)=0 & Lastpos(".type",FondName)=0) then do
  538.  
  539.                Font FondName
  540.                a=RC
  541.                If a=0 then do                  /* Kann FW den Font verarbeiten?*/
  542.                   Call FontBestimmen
  543.                   Font Softsans
  544.                   FontSize 11
  545.                   Type ShortFondName; NewParagraph
  546.  
  547.                   Font FondName
  548.                   FontSize 11
  549.                   Status BodyTextHeight
  550.                   th1=result
  551.                   Type "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG ÄÖÜ 0123456789"
  552.                   Status BodyTextHeight
  553.                   th2=result
  554.                   if th2>th1 then do
  555.                      ShiftDown
  556.                      do While 1        /* paßt nicht auf eine zeile*/
  557.                         Cursor Left
  558.                         Delete
  559.                         Status BodyTextHeight
  560.                         th2=result
  561.                         If th2=th1 then Break
  562.                      End
  563.                      ShiftUp; NewParagraph
  564.                   end
  565.                   else NewParagraph
  566.  
  567.                   Type "the quick brown fox jumps over the lazy dog äöüß"
  568.                   FontAnz=FontAnz+1
  569.                END
  570.                else do
  571.                   ret=rtezrequest("FW kann diesen Font nicht anzeigen..."R||FondName" ist kein FW typischer Font...",,"ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  572.                   BackSpace
  573.                End
  574.  
  575.                If FontAnz=12 then do
  576.                   call WH
  577.                   UNameFont=NameFont||"-"||DokAnz
  578.                   If (Speich=1|Speich=3) then Save UNameFont
  579.                   If (Speich=2|Speich=3) then Print
  580.                   Cleardoc force
  581.                   DokAnz=DokAnz+1; FontAnz=0
  582.  
  583.                   IF Gesch=2 THEN do
  584.                      View 20
  585.                      RedrawOFF
  586.                   End
  587.  
  588.                   If Punkt="Comma" then DocItemPrefs DECIMAL Period
  589.  
  590.                   Pagesetup Pagetype A4 Orient Tall Pages RightOnly Top 0 Bottom 2.54 Left 0 Right 0
  591.                   SectionSetup Top 2.54 Bottom 2.54 Inside 2 Outside 1
  592.  
  593.                   GraphicTool
  594.  
  595.                   LinePrefs LineWt .5
  596.                   DrawLine 1 2 3.5 20 3.5
  597.  
  598.                   If Locher=1 then DrawLine 1 .5 14.85 1 14.85
  599.  
  600.                   Justify Center
  601.                   Font Softsans
  602.                   FontSize 18
  603.                   Type FontVerz||" - "||DokAnz; NewParagraph
  604.  
  605.                   Justify Left
  606.                end
  607.                If a=0 then NewParagraph; NewParagraph
  608.             End
  609.             Stand=Seek("file",0,"C")
  610.             prozent=Trunc(Stand/Laenge*100)
  611.             CALL TR_SETATTRIBUTE(window1,7,'TRAT_Value',prozent)
  612.          END
  613.       END
  614.  
  615.       call WH
  616.  
  617.       /* Speichern */
  618.       If (Speich=1|Speich=3) then Save NameFont
  619.  
  620.       /* Drucken */
  621.       If (Speich=2|Speich=3) then Print
  622.  
  623.       Cleardoc force
  624.    END
  625.    else ret=rtezrequest("FW kann diesen Font nicht anzeigen..."R||FondName" ist kein FW typischer Font...",,"ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  626.    end
  627.    end
  628.    prozent=Trunc(Stand/Laenge*100)
  629.    CALL TR_SETATTRIBUTE(window1,7,'TRAT_Value',prozent)
  630.  
  631. END
  632. If Punkt="Comma" then DocItemPrefs DECIMAL Comma
  633. Return
  634.  
  635. FontBestimmen:
  636.    address(FW)
  637.    Type d2c(32)
  638.    BackSpace
  639.    status FontPath
  640.    FullFondName=result
  641.       
  642.    pos = max(index(FullFondName,':'),lastpos('/',FullFondName))
  643.    IF (pos~=0) THEN ShortFondName=RIGHT(FullFondName, LENGTH(FullFondName)-pos)
  644.  
  645.    If Ausgabe=2 then do
  646.       FontVerz=Left(FullFondName,pos)
  647.       FontVerz1=Left(FullFondName,pos-1)
  648.       pos = max(index(FontVerz1,':'),lastpos('/',FontVerz1))
  649.       IF (pos~=0) THEN SpeichName=RIGHT(FontVerz1, LENGTH(FontVerz1)-pos)
  650.    END
  651. Return
  652.  
  653. WH:
  654.    address(FW)
  655.    If Gesch=2 then View
  656.    RedrawON
  657.    Redraw
  658. Return
  659.  
  660. Voreinstellung:
  661. oldGesch=Gesch; oldLocher=Locher;oldSpeich=Speich
  662. windowtags =   WindowID(2),
  663.                WindowPosition('TRWP_CENTERDISPLAY'),
  664.                WindowFlags('TRWF_NOMINTEXTWIDTH|TRWF_NOSIZEGADGET'),
  665.                PubScreenName('FinalWriterPubScreen'),
  666.                WindowTitle('FontLook-Voreinsteller'),
  667.                'HorizGroupAC SpaceS',
  668.                   'VertGroupA SpaceS',
  669.                      'HorizGroupAC',
  670.                         TextID('Gesch_windigkeit: ',1),
  671.                         'SpaceS',
  672.                         CycleGadget('Geschlist',Gesch-1,1) 'TRAT_Flags TRCY_RIGHTLABELS' 'TRAT_Flags TRCY_RIGHTLABELS',
  673.                      'EndGroup',
  674.                      'SpaceS',
  675.                      'HorizGroupAC',
  676.                         TextID('_Lochermarken:    ',2),
  677.                         'SpaceS',
  678.                         CheckBox(2) 'TRAT_Value' Locher,
  679.                      'EndGroup',
  680.                      'SpaceS',
  681.                      'HorizGroupAC',
  682.                         TextID('Speichern/_Drucken:',3),
  683.                         'Spaces',
  684.                         CycleGadget('Speichlist',Speich-1,3) 'TRAT_Flags TRCY_RIGHTLABELS' 'TRAT_Flags TRCY_RIGHTLABELS',
  685.                      'EndGroup',
  686.                      'SpaceS',
  687.                      'HorizSeparator',
  688.                      'SpaceS',
  689.                      'HorizGroupEC',
  690.                         Button('_Sichern',15),
  691.                         'SpaceS',
  692.                         Button('_Anwenden',10),
  693.                         'SpaceS',
  694.                         Button('Ab_bruch',20),
  695.                      'EndGroup SpaceS',
  696.                   'EndGroup SpaceS',
  697.                'EndGroup SpaceS',
  698.             'EndProject'
  699.    app2 = TR_CREATEAPP('TRCA_Name FontLook2')
  700. IF app2 ~= '00000000'x THEN DO
  701.    window2 = TR_OPENPROJECT(app2,windowtags)
  702.    IF window2 ~= '00000000'x THEN DO
  703.       ende2 = 0
  704.  
  705.       DO WHILE ~ende2
  706.          CALL TR_WAIT(app2,'')
  707.  
  708.          DO WHILE TR_HANDLEMSG(app2,'event')
  709.             IF event.trm_class = 'TRMS_CLOSEWINDOW' THEN ende2=1
  710.  
  711.             IF event.trm_class = 'TRMS_NEWVALUE' THEN DO
  712.                SELECT
  713.                   WHEN event.trm_id = 1 THEN Gesch=event.trm_data+1    /*normal-speed Auswahl*/
  714.  
  715.                   WHEN event.trm_id = 2 THEN Locher=event.trm_data   /*Lochermarke*/
  716.  
  717.                   WHEN event.trm_id = 3 THEN Speich=event.trm_data+1   /*speichern-drucken Auswahl*/
  718.  
  719.                   OTHERWISE NOP
  720.                END
  721.  
  722.             End
  723.  
  724.             IF event.trm_class = 'TRMS_ACTION' THEN DO
  725.                SELECT
  726.                   WHEN event.trm_id = 10 THEN Call Schreiben      /*okay*/
  727.  
  728.                   WHEN event.trm_id = 15 THEN Do               /*speichern*/
  729.                      Call open('pref','S:FW_FontLook.prefs','W')
  730.                      writeln('pref',Art)      /*verz(0) oder file(1)*/
  731.                      writeln("pref",Ausgabe)  /*code(0) oder layout(1) oder Übersicht(2)*/
  732.                      writeln("pref",Schnitte) /*Schnitte*/
  733.                      writeln("pref",Locher)   /*lochermarke?*/
  734.                      writeln("pref",Gesch)    /*normal(0) oder speed(1)*/
  735.                      writeln("pref",Speich)   /*speichern(0), drucken(1), beides(2)*/
  736.                      writeln("pref",auswd)    /*ausgew. dir*/
  737.                      writeln("pref",auswf)    /*ausgew. filedir*/
  738.                      Call close('pref')
  739.  
  740.                      Call Schreiben
  741.                   END
  742.  
  743.                   WHEN event.trm_id = 20 THEN Do                /*Abbrechen*/
  744.                      Gesch=oldGesch; Locher=oldLocher; Speich=oldSpeich
  745.                      ende2=1
  746.                   END
  747.  
  748.                   OTHERWISE NOP
  749.                END
  750.             END
  751.          END
  752.       END
  753.       CALL TR_CLOSEPROJECT(window2)
  754.    END
  755.    CALL TR_DELETEAPP(app2)
  756. END
  757. ELSE
  758.    CALL quit('Kann das Fenster nicht öffnen',10)
  759.  
  760. Return
  761.  
  762. Schreiben:
  763.    If Locher=0 then LocherText="Nein"
  764.       Else LocherText="Ja"
  765.    o1="Geschwindigkeit: "||Geschlist.Gesch||", Lochermarken: "||LocherText
  766.    o2="Speichern/Drucken: "||Speichlist.Speich
  767.    Call TR_SETATTRIBUTE(window1,16,'TRAT_TEXT',o1)
  768.    Call TR_SETATTRIBUTE(window1,17,'TRAT_TEXT',o2)
  769.    ende2=1
  770. Return
  771.  
  772. /*******************************************************************************
  773. ** Routine, die bei einer Unterbrechung des Scripts aufgerufen wird
  774. *******************************************************************************/
  775.  
  776. SYNTAX:
  777.    CALL quit('Fehler' rc 'in Zeile' sigl '-' ERRORTEXT(rc)||R||SOURCELINE(sigl)||R||'Bitte informieren Sie den Autor...',20)
  778.  
  779. /*******************************************************************************
  780. ** Script beenden
  781. *******************************************************************************/
  782.  
  783. quit:
  784.    PARSE ARG message,rcode
  785.  
  786.    IF app ~= '00000000'x THEN DO
  787.       IF message ~= '' THEN
  788.          ret=rtezrequest(message,"_Okay","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  789.  
  790.       CALL TR_DELETEAPP(app)
  791.    END
  792.    ELSE
  793.       IF message ~= '' THEN DO
  794.          SAY message
  795.          SAY
  796.          OPTIONS PROMPT 'Bitte <RETURN> drücken'
  797.          PULL taste
  798.       END
  799.  
  800.    address command "flushtrx all"
  801.    EXIT(rcode)
  802.  
  803.